Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/bitmap/bitmapte.frm

Visual Basic Form | 1995-05-08 | 19.2 KB | 614 lines

VERSION 2.00
Begin Form BitmapTest
   BackColor       =   &H00FFFFFF&
   Caption         =   "Bitmaps, Device Contexts, Image and Picture Properties, Oh My!"
   ClientHeight    =   5445
   ClientLeft      =   825
   ClientTop       =   1335
   ClientWidth     =   9165
   Height          =   5850
   Left            =   765
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   5445
   ScaleWidth      =   9165
   Top             =   990
   Width           =   9285
   Begin CommandButton Quit
      Caption         =   "I'VE HAD IT!"
      Default         =   -1  'True
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   555
      Left            =   60
      TabIndex        =   22
      Top             =   4860
      Width           =   1515
   End
   Begin Frame Frame2
      Caption         =   "VB &Destination"
      Height          =   615
      Left            =   6960
      TabIndex        =   18
      Top             =   4800
      Width           =   2175
      Begin OptionButton DestImage
         Caption         =   ".Image"
         Height          =   255
         Left            =   1200
         TabIndex        =   20
         Top             =   240
         Width           =   855
      End
      Begin OptionButton DestPicture
         Caption         =   ".Picture"
         Height          =   255
         Left            =   120
         TabIndex        =   19
         Top             =   240
         Value           =   -1  'True
         Width           =   975
      End
   End
   Begin Frame Frame1
      Caption         =   "VB &Source"
      Height          =   615
      Left            =   1680
      TabIndex        =   15
      Top             =   4800
      Width           =   2175
      Begin OptionButton SrcImage
         Caption         =   ".Image"
         Height          =   255
         Left            =   1200
         TabIndex        =   17
         Top             =   240
         Width           =   855
      End
      Begin OptionButton SrcPicture
         Caption         =   ".Picture"
         Height          =   255
         Left            =   120
         TabIndex        =   16
         Top             =   240
         Value           =   -1  'True
         Width           =   975
      End
   End
   Begin ComboBox BltMode
      Height          =   300
      Left            =   4080
      Style           =   2  'Dropdown List
      TabIndex        =   34
      Top             =   4680
      Width           =   2535
   End
   Begin CheckBox GDIRefresh
      Caption         =   "&GDI Draw Auto-Refresh"
      Height          =   315
      Index           =   2
      Left            =   6660
      TabIndex        =   36
      Top             =   4500
      Width           =   2355
   End
   Begin CheckBox GDIRefresh
      Caption         =   "&GDI Draw Auto-Refresh"
      Height          =   315
      Index           =   1
      Left            =   1680
      TabIndex        =   31
      Top             =   4500
      Width           =   2355
   End
   Begin CommandButton PopOver
      Caption         =   "Pop Over..."
      Height          =   495
      Left            =   60
      TabIndex        =   21
      Top             =   4320
      Width           =   1515
   End
   Begin PictureBox ColorSet
      AutoRedraw      =   -1  'True
      Height          =   255
      Index           =   2
      Left            =   8100
      ScaleHeight     =   225
      ScaleWidth      =   465
      TabIndex        =   38
      Top             =   4230
      Width           =   495
   End
   Begin CheckBox AutoRedrawPic
      Caption         =   "&AutoRedraw"
      Height          =   255
      Index           =   2
      Left            =   6660
      TabIndex        =   14
      Top             =   4260
      Width           =   1335
   End
   Begin PictureBox ColorSet
      AutoRedraw      =   -1  'True
      Height          =   255
      Index           =   1
      Left            =   3180
      ScaleHeight     =   225
      ScaleWidth      =   465
      TabIndex        =   37
      Top             =   4230
      Width           =   495
   End
   Begin CheckBox AutoRedrawPic
      Caption         =   "&AutoRedraw"
      Height          =   255
      Index           =   1
      Left            =   1680
      TabIndex        =   13
      Top             =   4260
      Width           =   1335
   End
   Begin CommandButton Image2Picture
      Caption         =   "Image-->Picture"
      Height          =   375
      Index           =   2
      Left            =   4620
      TabIndex        =   30
      Top             =   3840
      Width           =   1695
   End
   Begin CommandButton Image2Picture
      Caption         =   "Image-->Picture"
      Height          =   375
      Index           =   1
      Left            =   60
      TabIndex        =   33
      Top             =   3840
      Width           =   1695
   End
   Begin CommandButton HideShow
      Caption         =   "Hide Picture -->"
      Height          =   375
      Index           =   2
      Left            =   4620
      TabIndex        =   29
      Top             =   3360
      Width           =   1695
   End
   Begin CommandButton HideShow
      Caption         =   "Hide Picture -->"
      Height          =   375
      Index           =   1
      Left            =   60
      TabIndex        =   28
      Top             =   3360
      Width           =   1695
   End
   Begin CommandButton FromClip
      Caption         =   "From Clipboard -->"
      Height          =   375
      Index           =   2
      Left            =   4620
      TabIndex        =   12
      Top             =   2880
      Width           =   1695
   End
   Begin CommandButton FromClip
      Caption         =   "From Clipbrd -->"
      Height          =   375
      Index           =   1
      Left            =   60
      TabIndex        =   5
      Top             =   2880
      Width           =   1695
   End
   Begin CommandButton ToClip
      Caption         =   "To Clipboard -->"
      Height          =   375
      Index           =   2
      Left            =   4620
      TabIndex        =   11
      Top             =   2520
      Width           =   1695
   End
   Begin CommandButton ToClip
      Caption         =   "To Clipboard -->"
      Height          =   375
      Index           =   1
      Left            =   60
      TabIndex        =   4
      Top             =   2520
      Width           =   1695
   End
   Begin CommandButton VB_Transfer_P1toP2
      Caption         =   ">-- VB Transfer -->"
      Height          =   375
      Left            =   4620
      TabIndex        =   10
      Top             =   2040
      Width           =   1695
   End
   Begin CommandButton GdiDraw_P1
      Caption         =   "VB Draw Mode"
      Height          =   375
      Left            =   60
      TabIndex        =   3
      Top             =   2040
      Width           =   1695
   End
   Begin CommandButton BitBlt_P1toP2
      Caption         =   ">-- BitBlt -->"
      Height          =   375
      Left            =   4620
      TabIndex        =   9
      Top             =   1680
      Width           =   1695
   End
   Begin CommandButton Blt2Image
      Caption         =   "BitBlt --> Image"
      Height          =   375
      Left            =   60
      TabIndex        =   32
      Top             =   1680
      Width           =   1695
   End
   Begin CommandButton SavePic
      Caption         =   "SavePicture()..."
      Height          =   375
      Index           =   2
      Left            =   4620
      TabIndex        =   40
      Top             =   1200
      Width           =   1695
   End
   Begin CommandButton SavePic
      Caption         =   "SavePicture()..."
      Height          =   375
      Index           =   1
      Left            =   60
      TabIndex        =   39
      Top             =   1200
      Width           =   1695
   End
   Begin CommandButton VB_LoadPic
      Caption         =   "LoadPicture()..."
      Height          =   375
      Index           =   2
      Left            =   4620
      TabIndex        =   7
      Top             =   840
      Width           =   1695
   End
   Begin CommandButton VB_LoadPic
      Caption         =   "LoadPicture()..."
      Height          =   375
      Index           =   1
      Left            =   60
      TabIndex        =   1
      Top             =   840
      Width           =   1695
   End
   Begin CommandButton VB_Refresh
      Caption         =   "VB Refresh  -->"
      Height          =   375
      Index           =   2
      Left            =   4620
      TabIndex        =   8
      Top             =   420
      Width           =   1695
   End
   Begin CommandButton VB_Refresh
      Caption         =   "VB Refresh  -->"
      Height          =   375
      Index           =   1
      Left            =   60
      TabIndex        =   2
      Top             =   420
      Width           =   1695
   End
   Begin PictureBox P2
      Height          =   4095
      Left            =   6360
      ScaleHeight     =   271
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   183
      TabIndex        =   23
      Top             =   120
      Width           =   2775
   End
   Begin PictureBox P1
      Height          =   4095
      Left            =   1800
      ScaleHeight     =   271
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   183
      TabIndex        =   25
      Top             =   120
      Width           =   2775
   End
   Begin CommandButton VB_Cls
      Caption         =   "VB Cls -->"
      Height          =   375
      Index           =   2
      Left            =   4620
      TabIndex        =   6
      Top             =   60
      Width           =   1695
   End
   Begin CommandButton VB_Cls
      Caption         =   "VB Cls -->"
      Height          =   375
      Index           =   1
      Left            =   60
      TabIndex        =   0
      Top             =   60
      Width           =   1695
   End
   Begin Label Status
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   3960
      TabIndex        =   24
      Top             =   5040
      Width           =   2895
   End
   Begin Label Label3
      Caption         =   "&Blt Mode:"
      Height          =   195
      Left            =   4980
      TabIndex        =   35
      Top             =   4440
      Width           =   855
   End
   Begin Label Label2
      Alignment       =   2  'Center
      Caption         =   "^ P2"
      Height          =   255
      Left            =   8640
      TabIndex        =   27
      Top             =   4260
      Width           =   495
   End
   Begin Label Label1
      Alignment       =   2  'Center
      Caption         =   "^ P1"
      Height          =   255
      Left            =   3900
      TabIndex        =   26
      Top             =   4260
      Width           =   555
   End
Dim Draw As Integer '-- drawing on or off
Dim GDI As Integer  '-- GDI=TRUE if drawing with GDI calls otherwise with VB methods
Sub AutoRedrawPic_Click (Index As Integer)
If Index = 1 Then
    P1.AutoRedraw = (AutoRedrawPic(1).Value = 1)
    P2.AutoRedraw = (AutoRedrawPic(2).Value = 1)
End If
End Sub
Sub BitBlt_P1toP2_Click ()
'-- BitBlt the entire area of P1 to P2
Result = BitBlt(P2.hDC, 0, 0, P2.ScaleWidth, P2.ScaleHeight, P1.hDC, 0, 0, BltModeArray(BltMode.ListIndex))
Status.Caption = "P1 BitBltted to P2"
'-- if the GDIRefresh box is checked, then refresh P2
If GDIRefresh(2).Value = 1 Then P2.Refresh
End Sub
Sub Blt2Image_Click ()
'BitBlt Screen to Image [from Keith Funk (72240,2020)]
If P1.AutoRedraw = True Then
    P1.AutoRedraw = False    'point to hDC of screen.
    hScreenDC = P1.hDC       'save it.
    P1.AutoRedraw = True     'point to hDC of Image.
    Result = BitBlt(P1.hDC, 0, 0, P1.ScaleWidth, P1.ScaleHeight, hScreenDC, 0, 0, BltModeArray(BltMode.ListIndex))
    hScreenDC = P1.hDC       'get hDC of Screen.
    P1.AutoRedraw = True     'point to hDC of Image.
    Result = BitBlt(P1.hDC, 0, 0, P1.ScaleWidth, P1.ScaleHeight, hScreenDC, 0, 0, BltModeArray(BltMode.ListIndex))
    P1.AutoRedraw = False
End If
Status.Caption = "P1 BitBltted to Itself"
'-- check if we should auto refresh after the bitblt
If GDIRefresh(1).Value = 1 Then P1.Refresh
End Sub
Sub ColorSet_Click (Index As Integer)
If Index = 1 Then
    ColorSet P1
    ColorSet P2
End If
End Sub
Sub Form_Load ()
'-- move the form to the upper left
Move 0, 0
'-- load the Blt Raster-OPs into the combo box for selection
BltMode.AddItem "SrcCopy"
BltMode.AddItem "SrcPaint"
BltMode.AddItem "SrcAND"
BltMode.AddItem "SrcInvert"
BltMode.AddItem "SrcErase"
BltMode.AddItem "NOTSrcCopy"
BltMode.AddItem "NOTSrcErase"
BltMode.AddItem "MergeCopy"
BltMode.AddItem "MergePaint"
BltMode.AddItem "PatCopy"
BltMode.AddItem "PatPaint"
BltMode.AddItem "PatInvert"
BltMode.AddItem "DstInvert"
BltMode.AddItem "Blackness"
BltMode.AddItem "Whiteness"
BltMode.ListIndex = 0
BltModeArray(0) = SRCCOPY
BltModeArray(1) = SRCPAINT
BltModeArray(2) = SRCAND
BltModeArray(3) = SRCINVERT
BltModeArray(4) = SRCERASE
BltModeArray(5) = NOTSRCCOPY
BltModeArray(6) = NOTSRCERASE
BltModeArray(7) = MERGECOPY
BltModeArray(8) = MERGEPAINT
BltModeArray(9) = PATCOPY
BltModeArray(10) = PATPAINT
BltModeArray(11) = PATINVERT
BltModeArray(12) = DSTINVERT
BltModeArray(13) = BLACKNESS
BltModeArray(14) = WHITENESS
For i = 1 To 2
    ColorSet(i).Cls
    ColorSet(i).ScaleMode = 3  '-- Pixels
    ColorWid = ColorSet(i).ScaleWidth \ 3
    ColorHgt = ColorSet(i).ScaleHeight
    ColorSet(i).Line (0, 0)-(ColorWid, ColorHgt), &HFF0000, BF
    ColorSet(i).Line (ColorWid + 1, 0)-(ColorWid * 2, ColorHgt), &HFF00&, BF
    ColorSet(i).Line (ColorWid * 2 + 1, 0)-(ColorWid * 3 + 2, ColorHgt), &HFF&, BF
End Sub
Sub FromClip_Click (Index As Integer)
If Index = 1 Then
    P1.Picture = ClipBoard.GetData()
    Status.Caption = "P1.Picture=ClipBoard"
    P2.Picture = ClipBoard.GetData()
    Status.Caption = "P2.Picture=ClipBoard"
End If
End Sub
Sub GdiDraw_P1_Click ()
If GDI Then
    GDI = False
    GDIDraw_P1.Caption = "VB Draw Mode"
    Status.Caption = "Now in VB Draw Mode"
    GDI = True
    GDIDraw_P1.Caption = "GDI Draw Mode"
    Status.Caption = "Now in GDI Draw Mode"
End If
End Sub
Sub HideShow_Click (Index As Integer)
If HideShow(Index).Caption = "Hide Picture -->" Then
    HideShow(Index).Caption = "Show Picture -->"
    Stat$ = "Hidden"
Else '-- it's already hidden and we'll be showing it
    HideShow(Index).Caption = "Hide Picture -->"
    Stat$ = "Visible"
End If
If Index = 1 Then '-- change P1's visible property
    P1.Visible = Not P1.Visible
    Status.Caption = "P1 is now " + Stat$
    P2.Visible = Not P2.Visible
    Status.Caption = "P2 is now " + Stat$
End If
End Sub
Sub Image2Picture_Click (Index As Integer)
If Index = 1 Then
    P1.Picture = P1.Image
    P2.Picture = P2.Image
End If
Pic$ = "P" + Format$(Index)
Status.Caption = Pic$ + ".Picture=" + Pic$ + ".Image"
End Sub
Sub P1_MouseDown (Button As Integer, Shift As Integer, x As Single, y As Single)
Draw = True
If GDI Then
    '-- set the pixel to black
    R& = SetPixel(P1.hDC, x, y, 0&)
    '-- move the current position for later LineTo's
    R& = MoveTo(P1.hDC, x, y)
    Status.Caption = "GDI Draw Started in P1"
    P1.PSet (x, y)
    Status.Caption = "VB Draw Started in P1"
End If
End Sub
Sub P1_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)
If Draw Then
    If GDI Then
        R% = LineTo(P1.hDC, x, y)
        If GDIRefresh(1).Value = 1 Then P1.Refresh
    Else
        P1.Line -(x, y)
    End If
End If
End Sub
Sub P1_MouseUp (Button As Integer, Shift As Integer, x As Single, y As Single)
Draw = False
If GDI Then
    Status.Caption = "GDI Draw Stopped in P1"
    Status.Caption = "VB Draw Stopped in P1"
End If
End Sub
Sub PopOver_Click ()
PopOverForm.Show MODAL
End Sub
Sub Quit_Click ()
End Sub
Sub ToClip_Click (Index As Integer)
ClipBoard.Clear
If Index = 1 Then
    If SrcPicture.Value Then '-- copy the .Picture property to the ClipBoard
        ClipBoard.SetData (P1.Picture)
        Status.Caption = "ClipBoard=P1.Picture"
    Else    '-- copy the .Image property to the ClipBoard
        ClipBoard.SetData (P1.Image)
        Status.Caption = "ClipBoard=P1.Image"
    End If
    If DestPicture.Value Then '-- copy the .Picture property to the ClipBoard
        ClipBoard.SetData (P2.Picture)
        Status.Caption = "ClipBoard=P2.Picture"
    Else    '-- copy the .Image property to the ClipBoard
        ClipBoard.SetData (P2.Image)
        Status.Caption = "ClipBoard=P2.Image"
    End If
End If
End Sub
Sub VB_Cls_Click (Index As Integer)
If Index = 1 Then
    P1.Cls
    P2.Cls
End If
Status.Caption = "Picture " + Format$(Index) + " CLSed"
End Sub
Sub VB_LoadPic_Click (Index As Integer)
' Before calling FOPEN.FRM we can specify a new pattern
' (ThePattern) a new path (ThePath) and a different
' Form Title.  Change FullName to an empty string.
FullName = ""
'-- we want to load either BMPs or WMFs, ICOs can't be used
ThePattern = "*.BMP;*.WMF"
FormTitle = "LoadPicture() Selection"
' We want to show the form Modal and Unload it after completion
' (no reason to waste resources).  Since the variables are
' global, we can unload it without worrying about referencing
' properties in an unloaded form, which would cause it to reload
FOpenForm.Show MODAL
Unload FOpenForm
If FullName = "CANCEL" Then Exit Sub
'-- note that if no filename was selected, FullName will
'   be null, which is OK with us because it'll mean that
'   we should just do a LoadPicture()
If Index = 1 Then
    P1.Picture = LoadPicture(FullName)
    P2.Picture = LoadPicture(FullName)
End If
Status.Caption = "P" + Format$(Index) + ".Picture=LoadPicture()"
End Sub
Sub VB_Refresh_Click (Index As Integer)
If Index = 1 Then
    P1.Refresh
    P2.Refresh
End If
Status.Caption = "P" + Format$(Index) + " Refreshed"
End Sub
Sub VB_Transfer_P1toP2_Click ()
If SrcPicture.Value Then
    P2.Picture = P1.Picture
    Status.Caption = "P2.Picture = P1.Picture"
    P2.Picture = P1.Image
    Status.Caption = "P2.Picture = P1.Image"
End If
End Sub